home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / COLOR.SWG / 0018_Select HIGH Back Colors.pas < prev    next >
Pascal/Delphi Source File  |  1993-06-22  |  2KB  |  93 lines
  1. PROGRAM HighBack;
  2.  
  3. USES Dos,Crt;
  4.  
  5. TYPE
  6.   AttrType = (Blinking,HighInt);
  7.  
  8. PROCEDURE SelectAttribute(Attribute: AttrType);
  9. VAR
  10.   Reg  :Registers;
  11. BEGIN
  12.   Reg.ah := $10;
  13.   Reg.al := 3;
  14.   CASE Attribute OF
  15.     HighInt  : Reg.bl := 0;
  16.     Blinking : Reg.bl := 1
  17.     END;
  18.   Intr($10,Reg)
  19.   END;
  20.  
  21. PROCEDURE SetBackground(BG: Byte);
  22. BEGIN
  23.   BG := (BG AND $F) SHL 4; {Limit to range 0 - 15, then shift up}
  24.   Crt.TextAttr := (Crt.TextAttr MOD 16) + BG;
  25.   END;
  26.  
  27. PROCEDURE SetForeground(FG: Byte);
  28. BEGIN
  29.   FG := (FG AND $F);                      {Limit to range 0 - 15}
  30.   Crt.TextAttr := (Crt.TextAttr AND $F0) + FG;
  31.   END;
  32.  
  33. FUNCTION GetBackground: Byte;
  34. BEGIN
  35.   GetBackground := Crt.TextAttr DIV 16;
  36.   END;
  37.  
  38. FUNCTION GetForeground: Byte;
  39. BEGIN
  40.   GetForeground := Crt.TextAttr MOD 16;
  41.   END;
  42.  
  43. CONST
  44.   Flip : Integer = 0;
  45.   BGM : Byte = Black;
  46.   FGM : Byte = White;
  47. VAR
  48.   BG, FG : Byte;
  49.   A : Char;
  50.  
  51. BEGIN
  52.  
  53. {Initialize screen}
  54.   TextMode(CO80);
  55.   TextBackGround(BGM);
  56.   TextColor(FGM);
  57.   ClrScr;
  58.  
  59. {Display demo color combinations}
  60.   GotoXY(35,1);WriteLn('Foreground');
  61.   Write('Background   ');
  62.   FOR FG := 0 TO $F DO Write(FG:3,' ');
  63.   WriteLn;WriteLn;
  64.  
  65.   FOR BG:= 0 TO $F DO BEGIN                {Cycle through colors}
  66.     SetBackground(BGM);
  67.     Write(BG:5,'       ');
  68.     SetBackground(BG);
  69.     FOR FG := 0 TO $F DO BEGIN
  70.       SetForeground(FG);                {Adjust FG for visibilty}
  71.       Write(Crt.TextAttr:4);
  72.       END;
  73.     WriteLn;
  74.     END;
  75.  
  76.   GotoXY(18,25);                                  {Create prompt}
  77.   SetBackground(LightCyan);
  78.   SetForeground(Black);
  79.   Write('Press <Esc> to quit, any other key to swap attributes');
  80.  
  81.   A := ' ';                             {Loop to swap attributes}
  82.   WHILE Ord(A) <> 27 DO BEGIN
  83.     CASE Flip OF
  84.        0 : SelectAttribute(HighInt);
  85.       -1 : SelectAttribute(Blinking);
  86.       END;
  87.     Flip := NOT Flip;
  88.     A := ReadKey;
  89.     END;
  90.   TextMode(CO80);
  91.   ClrScr
  92.   END.
  93.